home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 096 / sortusr2.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-12-22  |  1.4 KB  |  50 lines
  1. 10  '
  2. 20  '    RBBS USERS SORT
  3. 30  '    INITIAL CODING  12/09/84   TONY SHIMPS
  4. 40  '
  5. 50  KEY OFF:CLS:LOCATE 1,32:PRINT"RBBS USERS SORT":LOCATE 3,1
  6. 60  LC%=0:PG%=0:INPUT"USERS file is on drive: ";DRV$
  7. 70  DIM NAM$(999),REC%(999),SW%(20,2)
  8. 80  OPEN "R",#1,DRV$+":USERS",128
  9. 90  FIELD #1,31 AS N$,15 AS PW$,2 AS SL$,14 AS OP$,24 AS CS$,19 AS MA$,14 AS TD$,3 AS LND$,2 AS UDL$,2 AS UUL$,2 AS ET$
  10. 100  LAST%=LOF(1)/128:LOCATE 10,1:PRINT"Reading file..."
  11. 110  FOR I%=1 TO LAST%:GET #1,I%:O%=INSTR(N$," ")
  12. 120  IF (LEFT$(N$,1)<"A") OR (LEFT$(N$,1)>"Z") THEN LAST%=I%-1:GOTO 150
  13. 130  NAM$(I%)=RIGHT$(N$,(31-O%)):REC%(I%)=I%:NEXT I%
  14. 140  '
  15. 150  P%=1:SW%(P%,1)=1:SW%(P%,2)=LAST%
  16. 160  LOCATE 20,1:PRINT"Sorting ..";
  17. 170  IF P%<0 THEN 370
  18. 180  I1%=SW%(P%,1):J1%=SW%(P%,2)
  19. 190  P%=P%-1
  20. 200  GOSUB 210:GOTO 170
  21. 210  PRINT".";
  22. 220  IF J1%<=I1% THEN 360
  23. 230  I%=I1%:J%=J1%
  24. 240  SAMP%=-1
  25. 250  IF I%>=J% THEN 330
  26. 260  IF NAM$(I%)<=NAM$(J%) THEN 290
  27. 270  SWAP NAM$(I%),NAM$(J%):SWAP REC%(I%),REC%(J%)
  28. 280  SAMP%=-SAMP%
  29. 290  IF SAMP%<0 THEN 310
  30. 300  J%=J%-1:GOTO 320
  31. 310  I%=I%+1
  32. 320  GOTO 250
  33. 330  IF (I%+1)>=J1% THEN 350
  34. 340  P%=P%+1:SW%(P%,1)=I%+1:SW%(P%,2)=J1%
  35. 350  J1%=I%-1:GOTO 220
  36. 360  RETURN
  37. 370  '   END OF SORT
  38. 380  LOCATE 24,1:PRINT"Printing ...";
  39. 390  FOR I%=1 TO LAST%:GET #1,REC%(I%)
  40. 400  IF LC%=0 THEN GOSUB 450
  41. 410  LPRINT REC%(I%);TAB(7)N$;TAB(40)PW$;TAB(58)CVI(SL$)
  42. 420  LC%=LC%+1:IF LC%=56 THEN LC%=0
  43. 430  NEXT I%:CLOSE:CLS:BEEP:END
  44. 440  '
  45. 450  LPRINT CHR$(12):PG%=PG%+1
  46. 460  LPRINT DATE$;TAB(32)"RBBS USERS FILE";TAB(60)TIME$;TAB(72)"PAGE ";PG%
  47. 470  LPRINT:LPRINT
  48. 480  LPRINT"NO#";TAB(21)"NAME";TAB(43)"PASSWORD";TAB(59)"SEC."
  49. 490  LPRINT:RETURN
  50.